home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / t3_1 / xlib.lha / xlib / #hello.t# < prev    next >
Text File  |  1990-06-05  |  2KB  |  63 lines
  1. ;;;    Hello, World example from Oliver Jones' book in Scheme->C
  2.  
  3. (herald hello)
  4.  
  5.  
  6. (define (HELLO-WORLD displayname)
  7.     (let* ((hello "Hello, World")
  8.        (hi "Hi!")
  9.        (dpy (let ((x (xopendisplay displayname)))
  10.              (if (null-pointer? x)
  11.              (error "DISPLAY is not defined"))
  12.              x))
  13.        (screen (xdefaultscreen dpy))
  14.        (background (xwhitepixel dpy screen))
  15.        (foreground (xblackpixel dpy screen))
  16.        (window (xcreatesimplewindow dpy (xdefaultrootwindow dpy)
  17.                200 300 350 250 5 foreground background))
  18.        (gctxt (xcreategc dpy window 0 (make-xgcvalues)))
  19.        (event (make-xevent)))
  20.  
  21.       (xstorename dpy window
  22.           "Hello, World  in Scheme->C using X11's Xlib")
  23.       (xseticonname dpy window "hello")
  24.       (xsetbackground dpy gctxt background)
  25.       (xsetforeground dpy gctxt foreground)
  26.       (xselectinput dpy window
  27.           (fixnum-logior buttonpressmask 
  28.                  (fixnum-logior keypressmask exposuremask)))
  29.       (xmapraised dpy window)
  30.       (iterate loop ((grab-newline? t))
  31.         (readc (standard-input))
  32.         (let ((sel (yselect dpy (standard-input) 5 0)))
  33.           (cond ((null? sel) (format t "Timed out~%")
  34.                  (loop))
  35.             ((eq? sel dpy)
  36.              (ynextevent dpy event)
  37.              (cond ((eq? (xevent-type event) expose) (gc)
  38.               (xdrawimagestring (xevent-xexpose-display event)
  39.               (xevent-xexpose-window event) gctxt 50 50
  40.               hello (string-length hello))
  41.               (loop))
  42.              ((eq? (xevent-type event) mappingnotify)
  43.               (xrefreshkeyboardmapping event)
  44.               (loop))
  45.              ((eq? (xevent-type event) buttonpress)
  46.               (xdrawimagestring (xevent-xbutton-display event)
  47.               (xevent-xbutton-window event) gctxt
  48.               (xevent-xbutton-x event) (xevent-xbutton-y event)
  49.               hi (string-length hi))
  50.               (loop))
  51.              ((and (eq? (xevent-type event) keypress)
  52.                (equal? (ylookupstring event) "q"))
  53.               (xfreegc dpy gctxt)
  54.               (xdestroywindow dpy window)
  55.               (xclosedisplay dpy))
  56.              (else (loop))))
  57.             (else
  58.              (format t "Got ~s" (read sel))
  59.              (readc (standard-input))
  60.              (loop)))))))
  61.  
  62.  
  63.